home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
pctjoc85.arc
/
PENT.F77
< prev
next >
Wrap
Text File
|
1985-05-15
|
3KB
|
160 lines
* SOURCE FILE: PENT.F77
* EDIT DATE: 18MAR85
* AUTHOR: A. J. HOWARD
*
* PENTATHLON PROGRAM, FORTRAN 77 VERSION
PROGRAM PENT
INTEGER*2 I, ITER, BENCH
INTEGER*2 E (4), S (4)
1 WRITE (*, *)' Benchmark: '
READ (*, *)BENCH
IF (BENCH .LE. 0)STOP
WRITE (*, *)' Iterations: '
READ (*, *)ITER
CALL TIME (S)
DO 30 I = 1, ITER
GO TO (100, 200, 300, 400, 500), BENCH
100 CALL BENCH1
GO TO 30
200 CALL BENCH2
GO TO 30
300 CALL BENCH3
GO TO 30
400 CALL BENCH4
GO TO 30
500 CALL BENCH5
30 CONTINUE
CALL ETIME (E, S, ITER)
WRITE (*, *)' DONE- '
GO TO 1
END
* FLOATING POINT ARITHMETIC BENCHMARK
SUBROUTINE BENCH1
INTEGER*2 I, J
REAL X (100), Y (100), Z
DO 10 I = 1, 100
X (I) = I + 1
Y (I) = 3*I
10 CONTINUE
Z = 0.0
DO 20 J = 1, 10
DO 20 I = 1, 100
Z = Z + X (I)*Y (I)
20 CONTINUE
RETURN
END
* FUNCTION CALLING BENCHMARK
SUBROUTINE BENCH2
INTEGER*2 I, RESULT
INTEGER*2 DUMMY
DO 10 I = 1, 20000
RESULT = DUMMY (I)
10 CONTINUE
RETURN
END
INTEGER*2 FUNCTION DUMMY (I)
INTEGER*2 I
DUMMY = I + 1
RETURN
END
* STRING COPY BENCHMARK
SUBROUTINE BENCH3
INTEGER*2 I, J
CHARACTER*127 S, S2
DO 10 I = 1, 127
S (I: I) = 'A'
10 CONTINUE
DO 20 I = 1, 100
DO 20 J = 1, 127
S2 (J: J) = S (J: J)
20 CONTINUE
RETURN
END
* CHARACTER COUNT BENCHMARK
SUBROUTINE BENCH4
INTEGER*2 I, J, COUNT (64)
CHARACTER*127 S
DO 10 I = 1, 127
J = I
S (I: I) = CHAR (J)
10 CONTINUE
DO 20 J = 1, 200
CALL COUNTC (S, COUNT)
20 CONTINUE
RETURN
END
SUBROUTINE COUNTC (S, COUNT)
CHARACTER*127 S
INTEGER*2 COUNT (64)
INTEGER*2 I, C
DO 10 I = 1, 127
C = MOD (ICHAR (S (I: I)), 63) + 1
COUNT (C) = COUNT (C) + 1
10 CONTINUE
RETURN
END
* FILE COPY CHARACTER BY CHARACTER
SUBROUTINE BENCH5
INTEGER*2 IN, OUT
INTEGER*2 N
CHARACTER C
IN = 1
OUT = 2
OPEN (IN, FILE = 'A:TEST.IN',
1 STATUS = 'OLD',
1 FORM = 'UNFORMATTED')
OPEN (OUT, FILE = 'A:TEST.OUT',
1 STATUS = 'NEW',
1 FORM = 'UNFORMATTED')
N = 0
10 READ (IN, END = 20, ERR = 110) C
N = N + 1
WRITE (OUT, ERR = 120) C
GO TO 10
20 WRITE (*, *) N, ' CHARACTERS'
CLOSE (IN)
CLOSE (OUT)
RETURN
110 WRITE (*, *)'*** Read Error ***'
STOP
120 WRITE (*, *)'*** Write Error ***'
STOP
END